home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / bix03.arc / PBIOS.SYS < prev    next >
Text File  |  1986-08-04  |  5KB  |  150 lines
  1. (********************************************************************)
  2. (*                                                                  *)
  3. (*      PSEUDO    ROM BIOS Access Procedures                        *)
  4. (*                                                                  *)
  5. (*   Calls PSEUDO-BIOS Routines for modification of screen          *)
  6. (*   parameters.                                                    *)
  7. (*                                                                  *)
  8. (*                                                                  *)
  9. (*   written by:      John Leonard    1/25/86                       *)
  10. (*                                                                  *)
  11. (*        NOT FOR SALE WITHOUT WRITTEN PERMISSION                   *)
  12. (*                                                                    *)
  13. (*                                                                  *)
  14. (********************************************************************)
  15.  
  16.  
  17.  
  18. function WOffSet( row, column: integer) : integer;
  19.    begin
  20.       WOffSet := ( row * DefaultWidth) shl 1  +
  21.                  ( column shl 1);
  22.    end;
  23.  
  24.  
  25. function BlankLine( width: integer ) : Window_Big_String;
  26.    var i:integer;
  27.        temp : Window_Big_String;
  28.    begin
  29.       temp[0]:= char(width);
  30.       with currentscreendata do
  31.          for i := 0 to width do begin
  32.             temp[i*2+1] := char(filler);
  33.             temp[i*2+2] := char(attribute);
  34.          end;
  35.          blankline:= temp;
  36.       end;
  37.  
  38.  
  39. procedure WSetCursorPosition( ipage,row,column:integer);
  40.    begin
  41.       with currentscreendata do with windowloc[ipage] do begin
  42.          xloc := column;
  43.          yloc := row;
  44.       end;
  45.    end;
  46.  
  47.  
  48. procedure WReadCursorPosition(ipage : integer;
  49.               var irow,icolumn,is1,is2:integer);
  50.    begin
  51.       with currentscreendata do with windowloc[ipage] do begin
  52.          icolumn := xloc;
  53.          irow    := yloc;
  54.          is1     := s1;
  55.          is2     := s2;
  56.       end;
  57.    end;
  58.  
  59.  
  60. procedure WSetActiveDisplayPage(  i : integer);
  61.    begin
  62.       CurrentScreenData.page := i;
  63.    end;
  64.  
  65.  
  66. procedure WScrollWindowUp( lines,filler,y1,x1,y2,x2:integer);
  67.    var page,i,segment,width,oldoffset,newoffset : integer;
  68.        blank : Window_Big_String;
  69.        Lwidth: integer;
  70.    begin
  71.       page := currentscreendata.page;
  72.       Segment   := seg(displaystack[page]^);
  73.       Width     := (x2-x1+1) shl 1;
  74.       blank     := BlankLine(width);
  75.       if lines = 0 then
  76.          for i := y1 to y2 do begin
  77.             oldoffset := woffset(i,x1);
  78.             move( blank[1],mem[segment:oldoffset],width );
  79. {            fillchar( mem[segment:oldoffset],width,filler); }
  80.          end
  81.       else begin
  82.          for i := y1+lines to y2 do begin
  83.             OldOffset := woffset(i,x1);
  84.             NewOffset := woffset(i-lines,x1);
  85.             move( mem[segment:oldoffset],
  86.                      mem[segment:newoffset],
  87.                      Width);
  88.             end;
  89.          for i := y2-lines to y2 do begin
  90.             oldoffset := woffset(i,x1);
  91.             fillchar( mem[segment:oldoffset],width,filler);
  92.          end
  93.       end;
  94.    end;
  95.  
  96.  
  97. procedure WScrollWindowDown( lines,filler,y1,x1,y2,x2:integer);
  98.    var i,segment,width,oldoffset,newoffset,page : integer;
  99.    begin
  100.       page := currentscreendata.page;
  101.       Segment   := seg(displaystack[page]^);
  102.       Width     := (x2-x1+1) shl 1;
  103.       if lines = 0 then
  104.          for i := y1 to y2 do begin
  105.             oldoffset := woffset(i,x1);
  106.             fillchar( mem[segment:oldoffset],width,filler);
  107.          end
  108.       else begin
  109.          for i := y2-lines downto y1 do begin
  110.             OldOffset := woffset(i,x1);
  111.             NewOffset := woffset(i+lines,x1);
  112.             move( mem[segment:oldoffset],
  113.                      mem[segment:newoffset],
  114.                      Width);
  115.             end;
  116.          for i := y1 to y1+lines do begin
  117.             oldoffset := woffset(i,x1);
  118.             fillchar( mem[segment:oldoffset],width,filler);
  119.          end
  120.       end;
  121.    end;
  122.  
  123.  
  124. procedure WWriteCharacterAndAttribute( character,page,attribute,num:integer);
  125.    var segment,charoffset,i,j:integer;
  126.    begin
  127.       segment := seg(DisplayStack[page]^);
  128.       charoffset := woffset( currentscreendata.windowloc[page].yloc,
  129.                              currentscreendata.windowloc[page].xloc);
  130.       for i := 0 to num-1 do begin
  131.          j := i shl 1;
  132.          DisplayStack[page]^[charoffset+j] := character;
  133.          DisplayStack[page]^[charoffset+1+j] := attribute;
  134.       end;
  135.    end;
  136.  
  137.  
  138. procedure WWriteCharacter( character,page,num:integer);
  139.    var segment,charoffset,i,j:integer;
  140.    begin
  141.       segment := seg(DisplayStack[page]^);
  142.       charoffset := woffset( currentscreendata.windowloc[page].yloc,
  143.                              currentscreendata.windowloc[page].xloc);
  144.       for i := 0 to num-1 do begin
  145.          j := i shl 1;
  146.          DisplayStack[page]^[charoffset+j] := character;
  147.          DisplayStack[page]^[charoffset+1+j] := DefaultAttribute;
  148.       end;
  149.    end;
  150.